home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
007
/
turbo_tk.arc
/
READTTT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-02-01
|
6KB
|
182 lines
{$S-,R-,V-,D-,T-}
{\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
{ TechnoJocks Turbo Toolkit v4.00 Released: Feb 1, 1988 }
{ }
{ Module: ReadTTT -- single line input proc with full editing }
{ }
{ Copyright R. D. Ainsbury (c) 1986 }
{\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
Unit ReadTTT;
Interface
Uses CRT,FastTTT;
Procedure ReadLine(X,Y,L,F,B:byte;
var Text :string;
var Retcode:integer);
Implementation
Procedure ReadLine(X,Y,L,F,B:byte;
var Text :string;
var Retcode:integer);
Const
CursorRight = #205;
CursorLeft = #203;
EnterKey = #13;
EscKey = #27;
EndKey = #207;
HomeKey = #199;
DelKey = #211;
Backspace = #8;
InsKey = #210;
var
TempText : string;
CursorPos : byte;
InsertMode,
Alldone : boolean;
Ch : char;
Procedure Check_Parameters;
begin
TempText := Text;
If length(TempText) > L then
Delete(Temptext,L+1,length(TempText)-L);
If not X in [1..80] then
X := 1;
If X + L - 1 > 80 then X := 81 - L;
If not Y in [1..25] then
Y := 1;
If length(TempText) < L then
CursorPos := length(TempText) + 1
else
CursorPos := length(TempText);
Retcode := 0;
InsertMode := False;
Alldone := False;
end; {sub Proc Check_Parameters}
Function Underline(Str:string):string;
var I : integer;
begin
while length(Str) < L do
Str := Str + '_';
Underline := Str;
end; {sub Func Underline}
Procedure MoveTheCursor;
begin
GotoXY(X+CursorPos-1,Y);
end; {sub Proc MoveTheCursor}
Procedure Write_String;
begin
Fastwrite(X,Y,attr(F,B),Underline(TempText));
MoveTheCursor;
end;
Procedure Erase_Field;
begin
TempText := '';
CursorPos := 1;
Write_String;
end;
Procedure Char_Backspace;
begin
If CursorPos > 1 then
begin
CursorPos := Pred(CursorPos);
Delete(TempText,CursorPos,1);
Write_String;
end;
end; {sub Proc Char_Backspace}
Procedure Char_Del;
begin
If CursorPos <= length(TempText) then
begin
Delete(TempText,CursorPos,1);
Write_String;
end;
end; {sub Proc Char_Del}
begin {main Procedure IO1Line}
Check_Parameters;
Write_String;
Repeat
Ch:= Readkey;
If (Ch = EscKey) and keypressed then
begin
Ch := readkey;
Ch := chr(ord(Ch) + 128);
end;
Case upcase(Ch) of
CursorRight : begin
If (CursorPos < L)
and (CursorPos <= length(TempText)) then
begin
CursorPos := Succ(CursorPos);
MoveTheCursor;
end;
end;
CursorLeft : begin
If CursorPos > 1 then
begin
CursorPos := Pred(CursorPos);
MoveTheCursor;
end;
end;
HomeKey : begin
CursorPos := 1;
MoveTheCursor;
end;
EndKey : begin
If CursorPos < L then
If length(TempText) < L then
CursorPos := length(TempText) + 1
else
CursorPos := L;
MoveTheCursor;
end;
InsKey : InsertMode := not InsertMode;
DelKey : Char_Del;
BackSpace : Char_Backspace;
EscKey : begin
Alldone := true;
Retcode := 1;
end;
EnterKey : begin
Alldone := true;
Text := TempText;
end;
#32 .. #126 : begin
If InsertMode then
begin
If length(TempText) < L then
begin
Insert(Ch,TempText,CursorPos);
If CursorPos < L then
CursorPos := Succ(CursorPos);
end;
end
else {not insertmode}
begin
Delete(TempText,CursorPos,1);
Insert(Ch,TempText,CursorPos);
If CursorPos < L then
CursorPos := Succ(CursorPos);
end; {if insert}
Write_String;
end;
end; {case}
Until Alldone;
end; {Proc Read_Line}
end.